home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d13
/
pctv2n2.arc
/
SLOW.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-11
|
3KB
|
122 lines
{ slow.pas -- Draw polygon using conventional paint method }
program Slow;
{$R test.res} { Attach binary resources to .EXE file }
uses WinTypes, WinProcs, WObjects, Poly;
const
id_Menu = 100; { Menu resource ID }
cm_NewShape = 101; { Menu New Shape command ID }
cm_Quit = 102; { Menu Quit command ID }
numShapes = 5; { Number of polygons to display }
type
TestApplication = object(TApplication)
procedure InitMainWindow; virtual;
end;
PTestWindow = ^TestWindow;
TestWindow = object(TWindow)
PolyShapes: PCollection; { Collection of shapes }
constructor Init(AParent: PWindowsObject; ATitle: PChar);
destructor Done; virtual;
procedure CMNewShape(var Msg: TMessage);
virtual cm_First + cm_NewShape;
procedure CMQuit(var Msg: TMessage);
virtual cm_First + cm_Quit;
procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
virtual;
end;
{----- TestApplication methods -----}
{- Initialize TestApplication object's window }
procedure TestApplication.InitMainWindow;
begin
MainWindow := New(PTestWindow, Init(nil, 'Slow Paint Demo'));
Randomize
end;
{----- TestWindow methods -----}
{- Construct TestWindow object }
constructor TestWindow.Init(AParent: PWindowsObject;
ATitle: PChar);
var
I: Integer;
begin
TWindow.Init(AParent, ATitle);
PolyShapes := New(PCollection, Init(numShapes, 0));
if PolyShapes = nil then
begin
MessageBox(0, 'Not enough memory available',
'Fata Error', mb_SystemModal);
PostQuitMessage(0)
end;
Attr.Menu := LoadMenu(HInstance, PChar(id_Menu))
end;
{- Dispose of TestWindow object }
destructor TestWindow.Done;
begin
if PolyShapes <> nil then Dispose(PolyShapes, Done);
TWindow.Done
end;
{- Execute Menu:New Shape command }
procedure TestWindow.CMNewShape(var Msg: TMessage);
var
P: PPolygon;
I: Integer;
R: TRect;
begin
PolyShapes^.Freeall;
GetClientRect(HWindow, R);
for I := 0 to numShapes - 1 do
begin
P := New(PPolygon, Init(50, R.Right, R.Bottom));
if P <> nil then
PolyShapes^.Insert(P)
end;
InvalidateRect(HWindow, nil, true)
end;
{- Execute Menu:Exit command }
procedure TestWindow.CMQuit(var Msg: TMessage);
begin
CloseWindow
end;
{- Paint window's client area, showing current polygons }
procedure TestWindow.Paint(PaintDC: HDC;
var PaintInfo: TPaintStruct);
procedure DrawShape(P: PPolygon); far;
begin
P^.Draw(PaintDC)
end;
begin
PolyShapes^.ForEach(@DrawShape)
end;
var
SlowApp: TestApplication;
begin
SlowApp.Init('SlowApp');
SlowApp.Run;
SlowApp.Done
end.
{--------------------------------------------------------------
Copyright (c) 1991 by Tom Swan. All rights reserved.
Revision 1.00 Date: 3/26/1991
---------------------------------------------------------------}